Eigen Subroutine

public subroutine Eigen(A, lambda, vp, method, k)

Computes the eigenvalues and eigenvectors of a matrix A with A a square matrix, λ the eigenvalue, and v the eigenvector. This subroutine allows you to choose the method for computing eigenvalues and eigenvectors:

  • Power iteration
  • QR algorithm (with or without shift) The default method is Power iteration.

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in), DIMENSION(:, :) :: A
real(kind=dp), intent(out), DIMENSION(:) :: lambda
real(kind=dp), intent(out), optional, DIMENSION(:, :) :: vp
character(len=*), intent(in), optional :: method
integer, intent(in), optional :: k

Calls

proc~~eigen~~CallsGraph proc~eigen Eigen proc~identity_n Identity_n proc~eigen->proc~identity_n proc~normalise normalise proc~eigen->proc~normalise proc~qr_decomposition QR_decomposition proc~eigen->proc~qr_decomposition proc~norm_2 norm_2 proc~normalise->proc~norm_2 proc~qr_givens_decomposition QR_Givens_decomposition proc~qr_decomposition->proc~qr_givens_decomposition proc~qr_gram_schmidt_classical_decomposition QR_Gram_Schmidt_Classical_decomposition proc~qr_decomposition->proc~qr_gram_schmidt_classical_decomposition proc~qr_gram_schmidt_modified_decomposition QR_Gram_Schmidt_Modified_decomposition proc~qr_decomposition->proc~qr_gram_schmidt_modified_decomposition proc~qr_householder_decomposition QR_Householder_decomposition proc~qr_decomposition->proc~qr_householder_decomposition proc~qr_givens_decomposition->proc~identity_n proc~rotation_matrix rotation_matrix proc~qr_givens_decomposition->proc~rotation_matrix proc~qr_householder_decomposition->proc~identity_n proc~rotation_matrix->proc~identity_n

Called by

proc~~eigen~~CalledByGraph proc~eigen Eigen proc~is_spd is_SPD proc~is_spd->proc~eigen

Source Code

    SUBROUTINE Eigen(A, lambda, vp, method, k)
        REAL(dp), DIMENSION(:, :), INTENT(IN) :: A
        CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: method
        INTEGER, OPTIONAL, INTENT(IN) :: k
        REAL(dp), DIMENSION(:, :), OPTIONAL, INTENT(OUT) :: vp
        REAL(dp), DIMENSION(:), INTENT(OUT) :: lambda
        REAL(dp), DIMENSION(SIZE(A, 1),SIZE(A, 1)) :: A_tmp
        REAL(dp), DIMENSION(SIZE(A, 1),SIZE(A, 1)) :: vp_tmp
        CHARACTER(LEN = 50) :: base_method
        INTEGER :: N, i, k_max, pos

        IF(PRESENT(k)) THEN
            IF (k <= 0) STOP "ERROR :: k must be a positive integer"
            k_max = k
        ELSE
            k_max = kmax
        END IF
        
        N = SIZE(A, 1)
        IF(SIZE(A, 2) /= N) STOP "ERROR :: Matrix A not square"

        IF(SIZE(lambda, 1) /= N) STOP "ERROR :: dimension lambda"
        IF(PRESENT(vp) .AND. (SIZE(vp, 1) /= N .OR. SIZE(vp, 2) /= N)) STOP "ERROR :: dimension vp"

        IF(method == "Power_iteration")THEN

            A_tmp = A
            DO i=1, N
                CALL Power_iteration(A_tmp, lambda(i), vp_tmp(i, :), k_max)
                A_tmp = deflation(A_tmp, lambda(i), vp_tmp(i, :), k_max)
            END DO

            IF(PRESENT(vp)) vp = vp_tmp

        ELSE IF (INDEX(method, "QR") == 1) THEN

            IF(PRESENT(vp)) vp = 0
            IF(PRESENT(vp)) PRINT*, "WARNING :: No solution for eigenvectors with the QR method"

            pos = INDEX(TRIM(method), "_Shifted")

            IF (pos > 0 .AND. pos + 7 == LEN_TRIM(method)) THEN
                base_method = method(:pos - 1)
                CALL Eigen_QR_Shifted(A, lambda, base_method, N, k_max)
            ELSE
                CALL Eigen_QR(A, lambda, method, N, k_max)
            END IF

        ELSE
            STOP "ERROR :: Wrong method for Eigen"
        END IF

    END SUBROUTINE Eigen